home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS08.ADF / AmigaBasicProgs / DeluxeDraw < prev    next >
Text File  |  1986-04-02  |  22KB  |  679 lines
  1. ' DeluxeDraw
  2. ' By Rick Wirch
  3. ' This program can be found in the April issue of Amazing Computing
  4. ' PIM Publications, P.O. Box 869, Fall River, Mass. 02722 (617) 679-3109
  5. ' It is available on disk from the AMICUS Public Domain Library
  6. '
  7. ' Allocate enough memory to save entire screen into an array
  8. DEF FNArraySize& = 3+INT((BobRight+16)/16)*(BobBottom+1)*Depth
  9.  
  10.   BobRight = 600: BobBottom = 187 : Depth = 4
  11.   Size& = FNArraySize& * 2
  12.   IF FRE(0) AND FRE(-1) < Size& THEN PRINT "Not enough memory":END
  13.  
  14.   IF FRE(0) < Size& THEN 
  15.     CLEAR,Size&+24000
  16.     DEF FNArraySize& = 3+INT((BobRight+16)/16)*(BobBottom+1)*Depth
  17.   END IF
  18. '------------------------ 
  19.  
  20. DECLARE FUNCTION SetDrMd LIBRARY ' Set the Drawing Mode
  21. DECLARE FUNCTION Move LIBRARY    ' Move the Plotting Position
  22. DECLARE FUNCTION Flood LIBRARY   ' Flood Fill an Area
  23.  
  24. DEFINT a-z
  25.      
  26.   Depth = 0 
  27.   WHILE Depth < 2 OR Depth > 5
  28.     INPUT "Select number of bit planes (2-5) ", Depth
  29.   WEND 
  30.  
  31.   RES=0
  32.   IF Depth = 5 THEN
  33.     RES = 311
  34.   ELSE
  35.     WHILE RES=0
  36.       INPUT "Select resolution (Hi/Lo) ", C$
  37.       C$=LEFT$(C$,1)
  38.       IF C$="H" OR C$="h" THEN RES=631
  39.       IF C$="L" OR C$="l" THEN RES=311
  40.     WEND
  41.   END IF
  42.     
  43.   DIM PAT1%(1),PAT2%(1),PCan!(31,3) : DIM BobArray(1)
  44.   
  45.   RES2=RES/320   'For hi-res aspect ratio for circles
  46.   IF RES < 400 THEN scrmode = 1 ELSE scrmode = 2  
  47.   SCREEN 1, scrmode*320, 200, Depth, scrmode
  48.   CLS
  49.   WINDOW 2,"DeluxeDraw by Rick Wirch",(0,0)-(RES,186),0,1
  50.   WINDOW OUTPUT 2
  51.   
  52.   TRUE=-1: FALSE=0   'For convenience
  53.   IF Depth = 5 THEN COLBOX = 6 ELSE COLBOX = 10
  54.   FOR I=0 TO 15: PALETTE I, 6/15, 6/15, 6/15: NEXT
  55.   '  Set colors for Paintbox
  56.   PCan!(0,0)= 6/15: PCan!(0,1)= 6/15: PCan!(0,2)= 6/15   'Dark grey
  57.   PCan!(1,0)= 0/15: PCan!(1,1)= 0/15: PCan!(1,2)= 0/15   'Black
  58.   PCan!(2,0)=10/15: PCan!(2,1)=10/15: PCan!(2,2)=10/15   'Light grey
  59.   PCan!(3,0)=15/15: PCan!(3,1)=15/15: PCan!(3,2)=15/15   'White
  60.   PCan!(4,0)=15/15: PCan!(4,1)= 9/15: PCan!(4,2)= 9/15   'Pink
  61.   PCan!(5,0)=15/15: PCan!(5,1)= 6/15: PCan!(5,2)= 6/15   'Light Red
  62.   PCan!(6,0)=15/15: PCan!(6,1)= 2/15: PCan!(6,2)= 2/15   'Red
  63.   PCan!(7,0)=12/15: PCan!(7,1)= 0/15: PCan!(7,2)= 14/15  'Purple
  64.   PCan!(8,0)= 7/15: PCan!(8,1)=13/15: PCan!(8,2)= 15/15  'Light Blue
  65.   PCan!(9,0)= 8/15: PCan!(9,1)= 8/15: PCan!(9,2)= 15/15  'Med.  Blue
  66.   PCan!(10,0)= 4/15:PCan!(10,1)= 4/15:PCan!(10,2)=15/15  'Dark  Blue
  67.   PCan!(11,0)= 0/15:PCan!(11,1)=14/15:PCan!(11,2)= 13/15 'Aqua
  68.   PCan!(12,0)= 8/15:PCan!(12,1)=12/15:PCan!(12,2)= 8/15  'Light Green
  69.   PCan!(13,0)= 4/15:PCan!(13,1)=12/15:PCan!(13,2)= 4/15  'Med.  Green
  70.   PCan!(14,0)= 0/15:PCan!(14,1)=15/15:PCan!(14,2)= 0/15  'Dark  Green
  71.   PCan!(15,0)=15/15:PCan!(15,1)=15/15:PCan!(15,2)= 2/15  'Yellow
  72.   
  73.   PCan!(16,0)=0/15: PCan!(16,1)= 4/15: PCan!(16,2)= 4/15   'aquas
  74.   PCan!(17,0)=0/15: PCan!(17,1)= 6/15: PCan!(17,2)= 6/15  
  75.   PCan!(18,0)=0/15: PCan!(18,1)= 8/15: PCan!(18,2)= 8/15   
  76.   PCan!(19,0)=0/15: PCan!(19,1)=10/15: PCan!(19,2)= 10/15  
  77.   PCan!(20,0)=0/15: PCan!(20,1)=12/15: PCan!(20,2)= 12/15  
  78.   
  79.   PCan!(21,0)=15/15: PCan!(21,1)=15/15: PCan!(21,2)= 2/15   'yellows
  80.   PCan!(22,0)=15/15: PCan!(22,1)=15/15: PCan!(22,2)= 4/15  
  81.   PCan!(23,0)=15/15: PCan!(23,1)=15/15: PCan!(23,2)= 6/15  
  82.   PCan!(24,0)=15/15: PCan!(24,1)=15/15: PCan!(24,2)= 8/15 
  83.   PCan!(25,0)=15/15: PCan!(25,1)=15/15: PCan!(25,2)= 10/15  
  84.   PCan!(26,0)=15/15: PCan!(26,1)=15/15: PCan!(26,2)= 12/15
  85.   
  86.   PCan!(27,0)= 2/15: PCan!(27,1)= 15/15:PCan!(27,2)= 2/15   'greens
  87.   PCan!(28,0)= 4/15: PCan!(28,1)= 15/15:PCan!(28,2)= 4/15
  88.   PCan!(29,0)= 6/15: PCan!(29,1)= 15/15:PCan!(29,2)= 6/15
  89.   PCan!(30,0)= 8/15: PCan!(30,1)= 15/15:PCan!(30,2)= 8/15 
  90.   PCan!(31,0)= 10/15:PCan!(31,1)= 15/15:PCan!(31,2)= 10/15 
  91.  
  92.   FOR I=0 TO 2^Depth-1: PALETTE I, PCan!( I,0), PCan!( I,1), PCan!( I,2): NEXT
  93.   
  94.   LIBRARY "graphics.library"
  95.   RP& = WINDOW(8)               ' Pointer to the Raster Port
  96.   W=WINDOW( 2): H=WINDOW(3): WWIDTH=W: HEIGHT=H
  97.   '  Make color selection boxes
  98.   FOR Y=0 TO HEIGHT STEP COLBOX 
  99.     COL = (Y\COLBOX)
  100.     IF COL <= 2^Depth-1 THEN          
  101.       COLOR COL: LINE(0,Y)-(20,Y+COLBOX),,bf
  102.       LINE(0,Y)-(20,Y+COLBOX),1,b
  103.     END IF
  104.   NEXT
  105.   '  Make style selection boxes
  106.   COLOR 1: FOR Y=0 TO 150 STEP 10
  107.   LINE(21,Y)-(45,Y+10),,b: NEXT
  108.   '  Show brush widths
  109.   COLOR 2: REM OUTLINE 0: 
  110.   LINE(29,1)-( 37,9)
  111.   AREA(26,11): AREA( 32,11): AREA( 40,19): AREA( 34,19) : AREAFILL
  112.   AREA(24,21): AREA( 34,21): AREA( 42,29): AREA( 32,29) : AREAFILL
  113.   AREA(22,31): AREA( 36,31): AREA( 44,39): AREA( 30,39) : AREAFILL
  114.   '  Custom Brush
  115.   LINE(25,44)-(32,46),,bf: LINE(32,42)-(35,48),,bf: LINE(35,42)-(40,48),3,bf
  116.   '  Lines radiating from a point
  117.   LINE(26,52)-(41,52): LINE(26,52)-( 39,55): LINE( 26,52)-(36,57)
  118.   LINE(26,52)-(31,59): PSET(26,52),3
  119.   '  Area color/pattern fill
  120.   AREA(31,62): AREA( 38,65): AREA( 31,68): AREA( 24,65) : AREAFILL
  121.   COLOR 3: AREA( 39,65): AREA( 38,69): AREA( 40,69) : AREAFILL
  122.   '  Sizeable circle
  123.   COLOR 2: CIRCLE(33,75),4:PSET(33,75),3
  124.   '  Sizeable rectangle
  125.   LINE(25,82)-(40,88),,b: PSET(25,82),3: PSET(40,88),3
  126.   '  Moveable line
  127.   LINE(26,95)-( 39,95): PSET(25,95),3: PSET(40,95),3
  128.   '  Text onto bit map
  129.   CALL Move&( RP&, 29, 108): PRINT "T";
  130.   '  Adjust a color
  131.   LINE(23,112)-(43,114),3,bf: LINE(23,112)-(43,114),1,b
  132.   LINE(23,114)-(43,116),3,bf: LINE(23,114)-(43,116),1,b
  133.   LINE(23,116)-(43,118),3,bf: LINE(23,116)-(43,118),1,b
  134.   '  Set/reset pattern
  135.   PAT1%(0)=&HFFFF: PAT1%(1)=&HFFFF
  136.   PAT2%(0)=&HAAAA: PAT2%(1)=&H5555
  137.   PATTERN ,PAT2%
  138.   COLOR 1,2: LINE(22,121)-(44,129),,bf
  139.   PATTERN ,PAT1%: Dotty=FALSE
  140.   '  Color cycle
  141.   FOR I=3 TO 13: COL=I: IF COL > 2^Depth-1 THEN COL=0
  142.   COLOR COL: LINE(16+2*I,131)-(17+2*I,139): NEXT
  143.   COLOR 1: LINE(44,131)-( 44,139)
  144.   '  Cycle Draw
  145.   FOR I=1 TO 4: COL=I: IF COL > 2^Depth-1 THEN COL=0
  146.     COLOR COL: LINE(19+4*I,143)-(23+4*I,147): LINE(20+4*I,143)-(24+4*I,147)
  147.     LINE(21+4*I,143)-(25+4*I,147): LINE(22+4*I,143)-(26+4*I,147)
  148.   NEXT
  149.   '  Display Foreground and Background Colors
  150.   LINE(22,151)-(33,159),COL,bf: LINE(34,151)-(44,159),LASTCOLOR,bf
  151.  
  152.   '  Menu items
  153.   MENU 1,0,1, "Project"
  154.   MENU 1,1,1, "New  Painting"
  155.   MENU 1,2,1, "Load Brush   "
  156.   MENU 1,3,1, "Load Painting"
  157.   MENU 1,4,1, "Save Brush   "
  158.   MENU 1,5,1, "Save Painting"
  159.   MENU 1,6,1, "Quit         "
  160.   MENU 2,0,0,"" : MENU 3,0,0,""
  161.   MENU 4,0,0,""
  162.   
  163.  '  Initialize starting values
  164.  TextX = 47: TextY = 8: NOBRUSH = TRUE :AdjOff = TRUE ' Mode Booleans
  165.  CycCl = FALSE: CycDr = FALSE :  CSTOP = 2^Depth - 4  ' Cycling info
  166.  COL = 1 : LASTCOLOR = 0 : MaxColor = 2^Depth - 1     ' Color info
  167.  Style = 2: DY = Style - 1: DX = 2 * DY * RES2        ' Style info
  168.  GOSUB InitFile : GOSUB ResSel
  169.  
  170.  l = MOUSE(0): X = MOUSE(1): Y = MOUSE(2):
  171.  
  172.  '  Main loop - always return here or at next statement
  173.  
  174. Main:
  175.  WHILE l<>0: l = MOUSE(0): WEND
  176. Main2:
  177.  l = MOUSE(0):X = MOUSE(1):Y = MOUSE(2): Y=Y-1  'Fix Y to align better with pointer
  178.  IF MENU(0) THEN ON MENU(1) GOSUB NewPic, OpenBrush, Openfile, WriteBrush, Writefile, Quit
  179.  
  180.  J = J + 1 : IF J > COLEnd THEN J = COLStart
  181.  IF CycCl THEN   ' Cycle the colors
  182.    FOR I=COLStart TO COLEnd:PALETTE ((I+J) MOD CSpan)+COLStart, PCan!(I,0), PCan!(I,1), PCan!(I,2):NEXT
  183.  END IF
  184.   
  185.  IF CycDr THEN  ' Cycle the drawing color
  186.    COLOR J
  187.  END IF
  188.  
  189.  IF X<0 OR X>WWIDTH OR Y<0 OR Y>HEIGHT GOTO Main2
  190.  IF X>46 THEN   ' Paint in various Styles
  191.    IF Style <=4 THEN 
  192.      GOSUB NBrush
  193.    ELSE 
  194.      ON Style-4 GOSUB Brush,Dlines,DFill,DCircle,DBox,Dline,Dtext,AdjColor
  195.    END IF
  196.    GOTO Main2
  197.  END IF
  198.  '  Select Color
  199.  IF l = 0 OR l = -1 THEN GOTO Main2
  200.  IF X<21 THEN GOSUB SelColor: GOTO Main2   'Color/style selection
  201.  '  ---------------Erase Clear Save  Load  Exit  Exit
  202.  '  Select style
  203.  IF Y<120 THEN GOSUB SetStyle: GOTO Main2
  204.  '  set/reset pattern
  205.  IF Y<130 THEN GOSUB PatSet: GOTO Main
  206.  '  cycle the colors
  207.  IF Y<140 THEN GOSUB CycCol: GOTO Main
  208.  '  cycle draw
  209.  IF Y<150 THEN GOSUB CycDraw: GOTO Main
  210.  GOTO Main
  211.  
  212.  ' ----------------- Subroutines -----------------
  213.  '  Adjust the Red , Green , and Blue values for a color
  214.  '  Toggle Color Adjuster on
  215. AdjColor:
  216.  IF AdjOff THEN
  217.    BobRight = 223: BobBottom = 30
  218.    Size& = FNArraySize&\2: DIM SAVCOL&( Size&)
  219.    GET (58,50)-(281,80), SAVCOL&
  220.    GOSUB ColReq
  221.    AdjOff = FALSE
  222.  END IF
  223.   
  224.  '  If on end of slider, track with mouse, else move by steps
  225.  IF Y>51 AND Y<61 AND l<>0 THEN Gun=0
  226.  IF Y>61 AND Y<71 AND l<>0 THEN Gun=1
  227.  IF Y>71 AND Y<81 AND l<>0 THEN Gun=2
  228.  GOSUB Slider 
  229.  RETURN
  230.  
  231. Slider:
  232.    TopS = Gun*10 + 52: BottomS = Gun*10 + 58
  233.    Slide = PCan!(COL,Gun)*15*14 + 60
  234.    WHILE l<>0   'Move slider to follow mouse
  235.      G1=(Slide-59)\14
  236.      IF X>Slide THEN LINE(60,TopS)-(Slide,BottomS),3,bf
  237.      IF X<Slide THEN LINE(Slide,TopS)-(270,BottomS),0,bf
  238.      PCan!(COL,Gun)=G1/15
  239.      IF Gun=0 THEN RED = G1
  240.      IF Gun=1 THEN GRN = G1
  241.      IF Gun=2 THEN BLU = G1
  242.      Slide=X
  243.      IF Slide < 61 THEN Slide = 61
  244.      IF Slide > 269 THEN Slide = 269
  245.      PALETTE COL, RED/15, GRN/15, BLU/15
  246.      l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2)
  247.    WEND
  248.    RETURN
  249.    
  250. ColReq:
  251.    LINE (58,50)-(281,80),2,bf
  252.    CALL Move&( RP&, 273,58):PRINT "R"
  253.    CALL Move&( RP&, 273,68):PRINT "G"
  254.    CALL Move&( RP&, 273,78):PRINT "B"
  255.    l= MOUSE(0): X= MOUSE(1): Y= MOUSE(2)
  256.    RED = PCan!(COL,0)*15: GRN = PCan!(COL,1)*15: BLU = PCan!(COL,2)*15                     
  257.    LINE(58,50)-(271,60),1,b   'Box for R slider
  258.    LINE(60,52)-(RED*14+60,58),3,bf : LINE(RED*14+61,52)-(270,58),0,bf 
  259.    LINE(58,60)-(271,70),1,b   'Box for G slider
  260.    LINE(60,62)-(GRN*14+60,68),3,bf : LINE(GRN*14+61,62)-(270,68),0,bf  
  261.    LINE(58,70)-(271,80),1,b   'Box for B slider
  262.    LINE(60,72)-(BLU*14+60,78),3,bf : LINE(BLU*14+61,72)-(270,78),0,bf  
  263.  RETURN
  264.  
  265. '  Restore selection area
  266. ResSel:
  267.    '  Restore white borders for items selected
  268.    LINE(0,COLBOX*COL)-(20,COLBOX*(COL+1)),3,b
  269.    IF COL=3 THEN LINE(1,COLBOX*COL+1)-(19,COLBOX*(COL+1)-1),1,b
  270.    IF Style>0 THEN LINE(21,10*(Style-1))-(45,10*Style),3,b
  271.    IF Dotty THEN LINE(21,120)-(45,130),3,b
  272.    IF CycDr THEN LINE(21,140)-(45,150),3,b
  273.    LINE(22,151)-(33,159),COL,bf: LINE(34,151)-(44,159),LASTCOLOR,bf
  274.    COLOR COL, LASTCOLOR
  275.    RETURN
  276.    
  277. '  Various brush widths
  278. NBrush: 
  279.   IF l = 0 THEN 
  280.     LEFT = 47+ DX:        IF X<LEFT THEN X=LEFT
  281.     TOP = 0 + DY:         IF Y<TOP THEN Y=TOP
  282.     BOTTOM = HEIGHT-DY-1: IF Y>BOTTOM THEN Y=BOTTOM
  283.     RIGHT = WWIDTH-DX-1:  IF X>RIGHT THEN X=RIGHT
  284.     X1= X: Y1= Y
  285.   ELSE
  286.       IF X<LEFT THEN X=LEFT
  287.       IF Y<TOP THEN Y=TOP
  288.       IF Y>BOTTOM THEN Y=BOTTOM
  289.       IF X>RIGHT THEN X=RIGHT
  290.       IF X+DX>46 THEN AREA(X1-DX,Y1+DY): AREA(X1+DX,Y1-DY): AREA(X+DX,Y-DY): AREA(X-DX,Y+DY): AREAFILL
  291.       X1= X: Y1=Y: l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2): Y=Y-1: 
  292.   END IF
  293.   RETURN
  294.  
  295. '  Moveable line.  Each DRAW complements (XORs) the current colors,
  296. '  so two DRAW's will restore the original.  The same process
  297. '  is used for circles and rectangles in other routines
  298. Dline:
  299.    IF l = 0 THEN RETURN
  300.    X1=X: Y1=Y: x2=X: y2=Y: CALL SetDrMd&( RP&, 2)
  301.    WHILE l<>0
  302.      LINE(X1,Y1)-(x2,y2): LINE(X1,Y1)-(x2,y2)
  303.      x2=X: y2=Y
  304.      l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2): Y=Y-1: IF X<47 THEN X=47
  305.    WEND
  306.    '  Finished - now reset DRAWMODE and draw the final line
  307.    CALL SetDrMd&( RP&, 1): LINE(X1,Y1)-(x2,y2)
  308.    RETURN
  309.    
  310. '  Put text on bit map 
  311. Dtext:
  312.    C$= INKEY$: IF l = 0 AND C$="" THEN RETURN
  313.    IF l = 0 THEN
  314.      PRINT C$;
  315.      IF ASC(C$)=8 THEN TextX=TextX-8 ELSE TextX=TextX+8
  316.      IF TextX > WWIDTH THEN TextX = 47: TextY = TextY + 9 
  317.      CALL Move&( RP&, TextX, TextY)
  318.    ELSE
  319.      TextX= X: TextY= Y
  320.      CALL Move&( RP&, TextX, TextY)
  321.    END IF
  322.    RETURN
  323.  
  324. '  All lines from a point
  325. Dlines:
  326.   IF l= 0 THEN
  327.     X1=X: Y1=Y
  328.   ELSE
  329.     LINE (X1,Y1)-(X,Y)
  330.     l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2): Y=Y-1: IF X<47 THEN X=47
  331.   END IF
  332.   RETURN
  333.  
  334. '  Custom Brush
  335. Brush:
  336.       IF NOBRUSH THEN GOSUB NewBrush
  337.       IF l = 0 THEN
  338.         PUT( X,Y),BobArray,XOR: PUT( X,Y),BobArray,XOR 
  339.       ELSE
  340.         PUT( X,Y),BobArray,PSET
  341.       END IF
  342.       RETURN
  343.  
  344. NewBrush:
  345.       IF l = 0 OR X < 47 THEN RETURN
  346.       X1=X: Y1=Y: x2=X: y2=Y: CALL SetDrMd&( RP&, 2) 
  347.       WHILE l<>0
  348.         LINE(X1,Y1)-(x2,y2),,b: LINE(X1,Y1)-(x2,y2),,b
  349.         x2=X: y2=Y
  350.         l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2) : Y=Y-1: IF X<47 THEN X=47
  351.       WEND
  352.       CALL SetDrMd&( RP&, 1)
  353.       NOBRUSH = FALSE
  354.       ERASE BobArray
  355.       BobRight = x2-X1: BobBottom = y2-Y1
  356.       ArraySize&=FNArraySize&
  357.       DIM BobArray(ArraySize&)
  358.       GET (X1,Y1)-(x2,y2),BobArray
  359.       RETURN
  360.  
  361.  '  Area color/pattern fill.  Will not fill over a previously
  362.  '  pattern-filled area.  Line at X=46 keeps fill in working
  363.  '  portion of screen and prevents bleeding into adjoining areas
  364. DFill:
  365.    IF l=0 THEN RETURN
  366.    WHILE l<>0: l=MOUSE(0): WEND   
  367.    IF COL=1 OR COL=3 THEN LINE(46,0)-(46,187),2
  368.    CALL Flood&( RP&, 1, X, Y)
  369.    IF COL=1 OR COL=3 THEN LINE(46,0)-(46,187),0
  370.    RETURN
  371.  
  372.  '  Variable sized circle.  RES2 handles the x-y aspect
  373.  '  ration for high res screens
  374. DCircle:
  375.    IF l = 0 THEN RETURN
  376.    X1=X: Y1=Y: x2=X: y2=Y: R2=0 : R=0: CALL SetDrMd&( RP&, 2)
  377.    WHILE l<>0
  378.      R=SQR(((X1-X)/RES2)^2+(Y1-Y)^2)
  379.      IF X1-R*RES2<47 THEN R=(X1-47)/RES2  'Left limit of circle
  380.      CIRCLE(X1,Y1),R: CIRCLE(X1,Y1),R
  381.      x2=X: y2=Y: R2=R
  382.      l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2) : Y=Y-1: IF X<47 THEN X=47
  383.    WEND
  384.    CALL SetDrMd&( RP&, 1): CIRCLE(X1,Y1),R2
  385.    RETURN
  386.  
  387. '  Sizeable rectangle
  388. DBox:
  389.    IF l = 0 THEN RETURN
  390.    X1=X: Y1=Y: x2=X: y2=Y: CALL SetDrMd&( RP&, 2)
  391.    WHILE l<>0
  392.      LINE(X1,Y1)-(x2,y2),,b: LINE(X1,Y1)-(x2,y2),,b
  393.      x2=X: y2=Y
  394.      l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2) : Y=Y-1: IF X<47 THEN X=47
  395.    WEND
  396.    CALL SetDrMd&( RP&, 1): LINE(X1,Y1)-(x2,y2),,b
  397.    RETURN
  398.  
  399. '  Clear the Screen
  400. NewPic: 
  401.    Prompt$ = "  Press Return to New"
  402.    CANCEL=FALSE: GOSUB GetName ' get a filename
  403.    IF CANCEL THEN RETURN
  404.    FOR X=0 TO HEIGHT\2  'Add some pizazz to the clear
  405.      LINE(47+X,1+X)-(WWIDTH-X-1,HEIGHT-X),3,b
  406.      LINE(46+X,X)-(WWIDTH-X,HEIGHT-X),0,b
  407.    NEXT
  408.    GOSUB ResSel
  409.    RETURN
  410.    
  411. '  Save info
  412. '  PENDING is used to restore screen if window is resized
  413. '  NOFILE is used in checking if the file already exists
  414. '  CANCEL is set if the user cancels the save operation
  415. '  OK=1 if the file already exists, =2 if OK to replace it
  416. '  PENDING=3: NOFILE=FALSE: CANCEL=FALSE: OK=0
  417. '
  418. '  Load disk file
  419. '  PENDING=4: NOFILE=FALSE: CANCEL=FALSE
  420. '  File name requestor routine.  We'll be looking for mouse
  421. '  clicks as well as character input, so use GET versus INPUT
  422. '  to receive the file name. 
  423. '
  424. GetName:
  425.   BobRight = 190: BobBottom = 80
  426.   Size&=FNArraySize& \2
  427.   DIM SavReq&(Size&)
  428.   GET( 50,16)-(240,96), SavReq&
  429.   FOR I=0 TO 40  'Pop out the requestor box
  430.     LINE(90-I,56-I)-(200+I,56+I),2,b
  431.   NEXT
  432.   LINE(50,16)-(240,96),3,b
  433.   COLOR 1,2:CALL Move&(RP&,53,35): PRINT Prompt$;
  434.   LINE(69,50)-(218,62),3,b
  435.   '  This little box is the "cursor", in yellow
  436.   CURS=72: LINE(CURS,52)-(CURS+7,60),3,bf
  437.   LINE(166,74)-(219,86),3,b
  438.   COLOR 3,1: CALL Move&(RP&, 169,83): PRINT "Cancel";
  439.   '  Allowable file names (change it to suit your taste):
  440.   '     First character must be a letter
  441.   '     Remaining chars may be letters, numbers or . or -
  442.   '     Maximum of 13 chars 
  443.   '     No two . or - may be adjoining
  444.   '     No embedded blanks allowed
  445.   '
  446.   C$=INKEY$: WHILE C$<>"": C$=INKEY$: WEND   'Clear any queued input
  447.   FileName$=""
  448.  
  449. Loop:
  450.  C$=INKEY$: l=MOUSE(0): X=MOUSE(1):Y=MOUSE(2)
  451.  IF l<>0 THEN
  452.    WHILE l<>0: l=MOUSE(0): X=MOUSE(1):Y=MOUSE(2): WEND  'Wait for button release
  453.    '  See if we're in the CANCEL box
  454.    Y=Y-1  'For better pointer alignment
  455.    IF X>165 AND X<220 AND Y>73 AND Y<87 THEN 
  456.      CANCEL=TRUE: PUT(50,16),SavReq&,PSET: ERASE SavReq&: RETURN
  457.    END IF
  458.  END IF
  459.  IF C$="" THEN GOTO Loop
  460.  IF ASC(C$) = 13 THEN   '13=Carriage return
  461.    PUT( 50,16),SavReq&,PSET: ERASE SavReq&: COLOR COL, LASTCOLOR
  462.    RETURN
  463.  END IF
  464.  IF ASC(C$) = 8 THEN   '8=Backspace
  465.     IF LEN( FileName$) = 0 THEN GOTO Loop
  466.     FileName$=LEFT$(FileName$,LEN(FileName$)-1)  'Shorten name
  467.     LINE(CURS,52)-(CURS+7,60),2,bf  'Back up cursor
  468.     CURS=CURS-8: LINE(CURS,52)-(CURS+7,60),3,bf
  469.     GOTO Loop
  470.  END IF
  471.  IF LEN(FileName$) >= 17 GOTO Loop  'No more letters
  472.  IF RIGHT$(FileName$,1)="." OR RIGHT$(FileName$,1)="-" GOTO Loop
  473.  IF C$<" " OR C$>"z" GOTO Loop
  474.  '  Add this letter and advance cursor
  475.  FileName$= FileName$ + C$
  476.  LINE(CURS,52)-(CURS+7,60),2,bf
  477.  COLOR 1,2: CALL Move&(RP&,CURS,59): PRINT C$;
  478.  CURS=CURS+8: LINE(CURS,52)-(CURS+7,60),3,bf
  479.  GOTO Loop  'Get another character
  480.  
  481. '  Select a color
  482. SelColor:
  483.      WHILE l <> 0: l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2): WEND
  484.      IF X>21 THEN RETURN
  485.      '  Erase white highlight around former color
  486.      LINE(0,COLBOX*COL)-(20,COLBOX*(COL+1)),1,b
  487.      IF COL=3 THEN LINE(1,COLBOX*COL+1)-(19,COLBOX*(COL+1)-1),3,b
  488.      I=COL: COL=Y\COLBOX
  489.      IF COL > MaxColor THEN COL = 0
  490.      '  The previous color becomes the PENB color (for pattern)
  491.      IF I<>COL THEN LASTCOLOR=I
  492.      COLOR COL,LASTCOLOR
  493.      '  Add white highlight around the new color
  494.      LINE(0,COLBOX*COL)-(20,COLBOX*(COL+1)),3,b
  495.      '  Add an extra black highlight when color white is selected
  496.      IF COL=3 THEN LINE(1,COLBOX*COL+1)-(19,COLBOX*(COL+1)-1),1,b
  497.      '  Show the foreground and background colors
  498.      LINE(22,151)-(33,159),COL,bf: LINE(34,151)-(44,159),LASTCOLOR,bf
  499.      IF Style = 12 THEN GOSUB ColReq
  500.      GOSUB SetSpan 
  501.      FOR I=0 TO MaxColor: PALETTE I,PCan!(I,0),PCan!(I,1),PCan!(I,2): NEXT
  502.      COLOR COL,LASTCOLOR
  503.    RETURN
  504.    
  505. '  Set style (and brush width, adjusted for resolution)
  506. SetStyle:
  507.    WHILE l <> 0: l=MOUSE(0): X=MOUSE(1): Y=MOUSE(2): WEND
  508.    IF X<21 OR X>45 THEN RETURN
  509.    IF Style=5 AND (Y\10+1)=5 THEN NOBRUSH = TRUE
  510.    IF (Y\10+1) = Style THEN RETURN
  511.    IF Style>0 THEN LINE(21,10*(Style-1))-(45,10*Style),1,b
  512.    IF Style=12 THEN
  513.      PUT (58,50), SAVCOL&, PSET   'Clean up the screen
  514.      ERASE SAVCOL&
  515.      IF COL=0 THEN 
  516.        FOR I=31 TO 2^Depth STEP -1: PALETTE I, PCan!(0,0), PCan!(0,1), PCan!(0,2):NEXT
  517.      END IF
  518.      AdjOff = TRUE
  519.    END IF
  520.    Style=Y\10+1
  521.    IF Style>0 THEN LINE(21,10*(Style-1))-(45,10*Style),3,b
  522.    DY=Style-1: DX=2*DY*RES2   
  523.    RETURN
  524.  
  525. '  Set/reset pattern.  When pattern is in use, DOTTY=TRUE
  526. PatSet:
  527.  IF Dotty THEN
  528.    Dotty=FALSE: PATTERN ,PAT1%
  529.    LINE(21,120)-(45,130),1,b
  530.  ELSE
  531.    LINE(21,120)-(45,130),3,b
  532.    Dotty=TRUE: PATTERN ,PAT2%
  533.  END IF
  534.  GOSUB ResSel
  535.  COLOR COL, LASTCOLOR
  536.  RETURN
  537.  
  538. '  Cycle colors (except black, white and greys).  
  539. '  This option can give the effect of movement
  540. '  (as may be noted in the selection box itself)
  541.       
  542. CycCol:
  543.   IF CycCl THEN
  544.     CycCl = FALSE
  545.     ' -- restore the colors --
  546.     FOR I=0 TO MaxColor:PALETTE I, PCan!(I,0), PCan!(I,1), PCan!(I,2): NEXT
  547.     GOSUB ResSel
  548.   ELSE
  549.     CycCl = TRUE
  550.     GOSUB SetSpan
  551.   END IF
  552.   RETURN
  553.   
  554. CycDraw:
  555.   IF CycDr THEN
  556.     CycDr = FALSE
  557.     LINE (21,140)-(45,150),1,b
  558.     COLOR COL, LASTCOLOR
  559.   ELSE
  560.     CycDr = TRUE
  561.     LINE (21,140)-(45,150),3,b
  562.     GOSUB SetSpan
  563.   END IF
  564.   RETURN
  565.   
  566. SetSpan:
  567.     IF COL > LASTCOLOR THEN
  568.       COLStart = LASTCOLOR: COLEnd = COL
  569.     ELSE
  570.       COLStart = COL: COLEnd = LASTCOLOR
  571.     END IF
  572.     CSpan = COLEnd - COLStart + 1
  573.     RETURN
  574.  
  575. Quit:
  576.    Prompt$ = "  Press Return to Quit"
  577.    CANCEL=FALSE: GOSUB GetName ' get a filename
  578.    IF CANCEL THEN RETURN
  579.    LIBRARY CLOSE
  580.    WINDOW CLOSE 2: SCREEN CLOSE 1
  581.    END 
  582.  
  583. InitFile:
  584.   collisionPlaneIncluded=2  'never set by this editor
  585.   imageShadowIncluded=4     'never set by this editor
  586.   SAVEBACK=8                'save background before drawing BOB
  587.   OVERLAY=16                'color 0 for BOB is transparent, not black
  588.   SAVEBOB=32                'let BOB act like a paint brush
  589.   fVSprite = 0              'user can't edit sprite
  590.   FileName$=""
  591.   Flags=SAVEBACK+OVERLAY+fVSprite
  592.   BobRight=  WWIDTH-1
  593.   BobBottom= HEIGHT-1
  594.   PlanePick= MaxColor
  595.   RETURN 
  596.  
  597. OpenBrush:
  598.   NOBRUSH = FALSE
  599.   BrushLoad = TRUE
  600.   Prompt$ = " Enter Brush file name"
  601. Openfile:
  602.   IF NOT BrushLoad THEN Prompt$ = "Enter Picture file name"
  603.   PENDING=4: CANCEL=FALSE: GOSUB GetName ' get a filename
  604.   IF FileName$<>"" AND (NOT CANCEL) THEN 
  605.     OPEN FileName$ FOR INPUT AS 1 LEN=1024
  606.     olddepth = Depth
  607.     ColorSet=CVL(INPUT$(4,1))
  608.     DataSet=CVL(INPUT$(4,1))
  609.     Depth=CVL(INPUT$(4,1))
  610.     BobRight=CVL(INPUT$(4,1)) - 1
  611.     BobBottom=CVL(INPUT$(4,1)) - 1
  612.     REM --- UNDONE if ColorSet<>0 or DataSet<>0, read image.editor format file
  613.     Flags=CVI(INPUT$(2,1))
  614.     ' IF Flags AND 1 THEN fVSprite = 1 ELSE fVSprite = 0
  615.     IF PlanePick < CVI(INPUT$(2,1)) THEN
  616.       COLOR 3,0: 
  617.       LOCATE 3,8: PRINT "Error: file has more bit planes": 
  618.       LOCATE 4,8: PRINT "    than this screen has!"
  619.       COLOR COL,LASTCOLOR
  620.     ELSE
  621.       PlaneOnOff=CVI(INPUT$(2,1))
  622.       ERASE BobArray
  623.       ArraySize&=FNArraySize&
  624.       DIM BobArray(ArraySize&)
  625.       BobArray(0)=BobRight + 1
  626.       BobArray(1)=BobBottom + 1
  627.       BobArray(2)=Depth
  628.       FOR I=3 TO ArraySize&-1: BobArray(I)=CVI(INPUT$(2,1)):NEXT
  629.       IF NOT BrushLoad THEN GOSUB RedrawPicture
  630.     END IF
  631.     Depth = olddepth
  632.     CLOSE #1
  633.   END IF
  634.   PENDING = 0
  635.   BrushLoad = FALSE
  636.   RETURN
  637.  
  638. WriteBrush:
  639.   IF NOBRUSH THEN RETURN
  640.   BrushSave=TRUE
  641.   Prompt$ = " Enter Brush file name"
  642. Writefile: 
  643.   IF NOT BrushSave THEN Prompt$ = "Enter Picture file name" 
  644.   PENDING=3: CANCEL=FALSE: GOSUB GetName 'get a filename
  645.   IF FileName$<>"" AND (NOT CANCEL) THEN
  646.     IF NOT BrushSave THEN GOSUB GetPicture
  647.     OPEN FileName$ FOR OUTPUT AS 1 LEN=1024
  648.     PRINT #1, MKL$(0); 'ColorSet
  649.     PRINT #1, MKL$(0); 'DataSet
  650.     PRINT #1, MKI$(0);MKI$(BobArray(2)); 'depth
  651.     PRINT #1, MKI$(0);MKI$(BobArray(0)); 'width
  652.     PRINT #1, MKI$(0);MKI$(BobArray(1)); 'height
  653.     PRINT #1, MKI$(Flags);
  654.     PRINT #1, MKI$(PlanePick);  'planePick
  655.     PRINT #1, MKI$(0);  'planeOnOff
  656.     FOR I=3 TO ArraySize&-1 : PRINT #1, MKI$(BobArray(I)); : NEXT
  657.     CLOSE#1
  658.   END IF
  659.   PENDING = 0
  660.   BrushSave = FALSE
  661.   RETURN
  662.  
  663. GetPicture:
  664.   BobRight = WWIDTH-1: BobBottom = HEIGHT-1
  665.   ArraySize&=FNArraySize&
  666.   ERASE BobArray
  667.   DIM BobArray(ArraySize&)
  668.   GET (47,0)-(BobRight,BobBottom),BobArray
  669.   RETURN
  670.  
  671. RedrawPicture:
  672.   PUT (47,0),BobArray,PSET
  673.   GOSUB ResSel 'redo the command box
  674.   ERASE BobArray
  675.   DIM BobArray(1)
  676.   RETURN
  677.  
  678.  
  679.